!> date: 2022-06-10
!> Fortran链表/容器实现
module dlinked_list_m

    implicit none
    private

    public :: linked_list_t

    !> 链表存储节点
    type node_t
        private
        type(node_t), pointer :: prev => null()     !! 前驱节点
        type(node_t), pointer :: next => null()     !! 后续节点
        class(*), allocatable :: item               !! 存储项
    contains
        procedure :: clear => node_t_clear
    end type node_t

    !> 链表
    type linked_list_t
        integer, private :: num_nodes = 0           !! 当前节点数
        type(node_t), pointer :: head => null()     !! 头节点
        type(node_t), pointer :: tail => null()     !! 尾节点
    contains
        procedure :: push => linked_list_t_push         ! 尾部插入
        procedure :: pop => linked_list_t_pop           ! 尾部删除
        procedure :: insert => linked_list_t_insert     ! 指定位置插入
        procedure :: remove => linked_list_t_remove     ! 指定位置删除
        generic :: get => linked_list_t_get_generic, &
            linked_list_t_user_get                      ! 指定位置获取
        procedure, private :: linked_list_t_get_generic, &
            linked_list_t_user_get                      ! 指定位置获取
        procedure :: replace => linked_list_t_replace   ! 指定位置替换
        procedure :: size => linked_list_t_size         ! 获取链表大小
        procedure :: reverse => linked_list_t_reverse   ! 链表反转
        procedure :: clear => linked_list_t_clear       ! 清空链表
    end type linked_list_t

    abstract interface
        subroutine get_value(this_item, return_item)
            class(*), intent(in) :: this_item
            class(*), intent(out) :: return_item
        end subroutine get_value
    end interface

contains

    !> 创建链表节点
    pure function init_node(new_item) result(new_node)
        type(node_t) :: new_node
        class(*), intent(in) :: new_item

        allocate (new_node%item, source=new_item)

    end function init_node

    !> 销毁链表节点
    pure subroutine node_t_clear(this_node)
        class(node_t), intent(inout) :: this_node

        ! 销毁节点内容
        if (allocated(this_node%item)) deallocate (this_node%item)

        ! 置空前后指针
        nullify (this_node%prev)
        nullify (this_node%next)

    end subroutine node_t_clear

    !> 尾部插入
    pure subroutine linked_list_t_push(this_list, item)
        class(linked_list_t), intent(inout) :: this_list
        class(*), intent(in) :: item

        if (associated(this_list%tail)) then
            allocate (this_list%tail%next, source=init_node(item))
            this_list%tail%next%prev => this_list%tail
            this_list%tail => this_list%tail%next
        else
            allocate (this_list%head, source=init_node(item))
            this_list%tail => this_list%head
        end if

        this_list%num_nodes = this_list%num_nodes + 1

    end subroutine linked_list_t_push

    !> 尾部删除
    pure subroutine linked_list_t_pop(this_list)
        class(linked_list_t), intent(inout) :: this_list
        type(node_t), pointer :: curr_node

        if (this_list%num_nodes == 0) return

        curr_node => this_list%tail
        if (associated(curr_node%prev) .and. associated(curr_node%next)) then
            curr_node%next%prev => curr_node%prev
            curr_node%prev%next => curr_node%next

        elseif (associated(curr_node%prev)) then
            nullify (curr_node%prev%next)
            this_list%tail => curr_node%prev

        elseif (associated(curr_node%next)) then
            nullify (curr_node%next%prev)
            this_list%head => curr_node%next

        else
            nullify (this_list%head)
            nullify (this_list%tail)
        end if

        call curr_node%clear()
        deallocate (curr_node)

        this_list%num_nodes = this_list%num_nodes - 1

    end subroutine linked_list_t_pop

    !> 指定位置插入
    pure subroutine linked_list_t_insert(this_list, item, node_index)
        class(linked_list_t), intent(inout) :: this_list
        class(*), intent(in) :: item
        integer, intent(in) :: node_index
        type(node_t), pointer :: curr_node
        type(node_t), pointer :: next_node

        integer index

        index = node_index - 1

        if (index >= this_list%num_nodes) then ! 尾部插入
            call this_list%push(item)
        elseif (index <= 0) then  ! 首部插入
            curr_node => this_list%head
            allocate (this_list%head, source=init_node(item))
            this_list%head%next => curr_node
            curr_node%prev => this_list%head
            nullify (curr_node)
        else ! 指定位置插入
            curr_node => this_list%head
            do while (index > 1)
                index = index - 1
                curr_node => curr_node%next
            end do

            next_node => curr_node%next
            allocate (curr_node%next, source=init_node(item))
            curr_node%next%prev => curr_node
            curr_node%next%next => next_node
            curr_node => curr_node%next
            curr_node%next%prev => curr_node

            this_list%num_nodes = this_list%num_nodes + 1
            nullify (next_node, curr_node)
        end if

    end subroutine linked_list_t_insert

    !> 指定位置删除
    pure subroutine linked_list_t_remove(this_list, node_index)
        class(linked_list_t), intent(inout) :: this_list
        integer, intent(in) :: node_index
        type(node_t), pointer :: curr_node

        integer index

        if (node_index < 1 .or. node_index > this_list%num_nodes) return

        curr_node => this_list%head

        index = 1
        do while (associated(curr_node))
            if (index == node_index) then
                if (associated(curr_node%prev) .and. associated(curr_node%next)) then
                    curr_node%next%prev => curr_node%prev
                    curr_node%prev%next => curr_node%next

                elseif (associated(curr_node%prev)) then
                    nullify (curr_node%prev%next)
                    this_list%tail => curr_node%prev

                elseif (associated(curr_node%next)) then
                    nullify (curr_node%next%prev)
                    this_list%head => curr_node%next

                else
                    nullify (this_list%head)
                    nullify (this_list%tail)
                end if

                call curr_node%clear()
                deallocate (curr_node)

                this_list%num_nodes = this_list%num_nodes - 1
                return
            end if

            curr_node => curr_node%next
            index = index + 1
        end do

    end subroutine linked_list_t_remove

    !> 获取节点值
    impure subroutine linked_list_t_get_generic(this_list, node_index, return_item)
        class(linked_list_t), intent(inout) :: this_list
        integer, intent(in) :: node_index
        class(*), pointer, intent(out) :: return_item
        type(node_t), pointer :: curr_node
        integer index

        if (node_index < 1 .or. node_index > this_list%num_nodes) then
            nullify (return_item)
            return
        end if

        curr_node => this_list%head
        index = 1
        do while (associated(curr_node))
            if (index == node_index) then
                return_item => curr_node%item
                nullify (curr_node)
                return
            end if

            curr_node => curr_node%next
            index = index + 1
        end do
        nullify (curr_node)
        nullify (return_item)

    end subroutine linked_list_t_get_generic

    !> 获取节点值 (用户定义)
    impure subroutine linked_list_t_user_get(this_list, node_index, func, return_item)
        class(linked_list_t), intent(inout) :: this_list
        integer, intent(in) :: node_index
        procedure(get_value) :: func
        class(*), intent(out) :: return_item
        type(node_t), pointer :: curr_node
        integer :: index

        if (node_index < 1 .or. node_index > this_list%num_nodes) return
        curr_node => this_list%head
        index = 1
        do while (associated(curr_node))
            if (index == node_index) then
                call func(curr_node%item, return_item)
                nullify (curr_node)
                return
            end if

            curr_node => curr_node%next
            index = index + 1
        end do
        nullify (curr_node)

    end subroutine linked_list_t_user_get

    !> 替换节点值
    pure subroutine linked_list_t_replace(this_list, item, node_index)
        class(linked_list_t), intent(inout) :: this_list
        integer, intent(in) :: node_index
        class(*), intent(in) :: item
        type(node_t), pointer :: curr_node
        integer index

        if (index < 1 .or. index > this_list%num_nodes) return
        index = node_index

        curr_node => this_list%head
        do while (index > 1)
            index = index - 1
            curr_node => curr_node%next
        end do
        curr_node%item = item

    end subroutine linked_list_t_replace

    !> 获取链表长度
    pure function linked_list_t_size(this_list) result(size)
        class(linked_list_t), intent(in) :: this_list
        integer size

        size = this_list%num_nodes

    end function linked_list_t_size

    !> 反转链表
    pure subroutine linked_list_t_reverse(this_list)
        class(linked_list_t), intent(inout) :: this_list
        type(node_t), pointer :: temp_node
        type(node_t), pointer :: curr_node

        nullify (temp_node)
        curr_node => this_list%head
        do while (associated(curr_node))
            temp_node => curr_node%prev
            curr_node%prev => curr_node%next
            curr_node%next => temp_node
            curr_node => curr_node%prev
        end do

        temp_node => this_list%head
        this_list%head => this_list%tail
        this_list%tail => temp_node

    end subroutine linked_list_t_reverse

    !> 销毁链表
    pure subroutine linked_list_t_clear(this_list)
        class(linked_list_t), intent(inout) :: this_list
        type(node_t), pointer :: curr_node

        do while (this_list%num_nodes > 0)
            curr_node => this_list%head
            if (associated(curr_node%next)) then
                nullify (curr_node%next%prev)
                this_list%head => curr_node%next
            end if
            call curr_node%clear()
            deallocate (curr_node)
            this_list%num_nodes = this_list%num_nodes - 1
        end do

        nullify (this_list%head, this_list%tail)

    end subroutine linked_list_t_clear

end module dlinked_list_m
